home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / electric / ehelp.el.z / ehelp.el
Encoding:
Text File  |  1998-05-21  |  15.2 KB  |  419 lines
  1. ;;; ehelp.el --- bindings for electric-help mode
  2.  
  3. ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Richard Mlynarik <mly@ai.mit.edu>
  6. ;; Maintainer: FSF
  7. ;; Keywords: help, extensions
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24. ;; 02111-1307, USA.
  25.  
  26. ;;; Synched up with: FSF 19.34.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; This package provides a pre-packaged `Electric Help Mode' for
  31. ;; browsing on-line help screens.  There is one entry point,
  32. ;; `with-electric-help'; all you have to give it is a no-argument
  33. ;; function that generates the actual text of the help into the current
  34. ;; buffer.
  35.  
  36. ;; To make this the default, you must do
  37. ;; (require 'ehelp)
  38. ;; (define-key global-map "\C-h" 'ehelp-command)
  39. ;; (define-key global-map [help] 'ehelp-command)
  40. ;; (define-key global-map [f1] 'ehelp-command)
  41.  
  42. ;;; Code:
  43.  
  44. (require 'electric)
  45. (defvar electric-help-map ()
  46.   "Keymap defining commands available in `electric-help-mode'.")
  47.  
  48. (defvar electric-help-form-to-execute nil)
  49.  
  50. (put 'electric-help-undefined 'suppress-keymap t)
  51. (if electric-help-map
  52.     ()
  53.   (let ((map (make-keymap)))
  54.     ;; allow all non-self-inserting keys - search, scroll, etc, but
  55.     ;; let M-x and C-x exit ehelp mode and retain buffer:
  56.     (suppress-keymap map)
  57.     (define-key map "\C-u" 'electric-help-undefined)
  58.     (define-key map [(control ?0)] 'electric-help-undefined)
  59.     (define-key map [(control ?1)] 'electric-help-undefined)
  60.     (define-key map [(control ?2)] 'electric-help-undefined)
  61.     (define-key map [(control ?3)] 'electric-help-undefined)
  62.     (define-key map [(control ?4)] 'electric-help-undefined)
  63.     (define-key map [(control ?5)] 'electric-help-undefined)
  64.     (define-key map [(control ?6)] 'electric-help-undefined)
  65.     (define-key map [(control ?7)] 'electric-help-undefined)
  66.     (define-key map [(control ?8)] 'electric-help-undefined)
  67.     (define-key map [(control ?9)] 'electric-help-undefined)
  68.     (define-key map (vector help-char) 'electric-help-help)
  69.     (define-key map "?" 'electric-help-help)
  70.     ;; XEmacs addition
  71.     (define-key map 'help 'electric-help-help)
  72.     (define-key map " " 'scroll-up)
  73.     (define-key map "\^?" 'scroll-down)
  74.     (define-key map "." 'beginning-of-buffer)
  75.     (define-key map "<" 'beginning-of-buffer)
  76.     (define-key map ">" 'end-of-buffer)
  77.     ;(define-key map "\C-g" 'electric-help-exit)
  78.     (define-key map "q" 'electric-help-exit)
  79.     (define-key map "Q" 'electric-help-exit)
  80.     ;;a better key than this?
  81.     (define-key map "r" 'electric-help-retain)
  82.     (define-key map "R" 'electric-help-retain)
  83.     (define-key map "\ex" 'electric-help-execute-extended)
  84.     (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
  85.  
  86.     (setq electric-help-map map)))
  87.  
  88. (defun electric-help-mode ()
  89.   "`with-electric-help' temporarily places its buffer in this mode.
  90. \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
  91.   (setq buffer-read-only t)
  92.   (setq mode-name "Help")
  93.   (setq major-mode 'help)
  94.   (setq modeline-buffer-identification '(" Help:  %b"))
  95.   (use-local-map electric-help-map)
  96.   (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
  97.   (view-mode -1)
  98.   ;; this is done below in with-electric-help
  99.   ;(run-hooks 'electric-help-mode-hook)
  100.   )
  101.  
  102. ;;;###autoload
  103. (defun with-electric-help (thunk &optional buffer noerase minheight)
  104.   "Pop up an \"electric\" help buffer.
  105. The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT.
  106. THUNK is a function of no arguments which is called to initialize the
  107. contents of BUFFER.  BUFFER defaults to `*Help*'.  BUFFER will be
  108. erased before THUNK is called unless NOERASE is non-nil.  THUNK will
  109. be called while BUFFER is current and with `standard-output' bound to
  110. the buffer specified by BUFFER.
  111.  
  112. If THUNK returns nil, we display BUFFER starting at the top, and
  113. shrink the window to fit.  If THUNK returns non-nil, we don't do those things.
  114.  
  115. After THUNK has been called, this function \"electrically\" pops up a window
  116. in which BUFFER is displayed and allows the user to scroll through that buffer
  117. in electric-help-mode. The window's height will be at least MINHEIGHT if
  118. this value is non-nil.
  119.  
  120. If THUNK returns nil, we display BUFFER starting at the top, and
  121. shrink the window to fit.  If THUNK returns non-nil, we don't do those
  122. things.
  123.  
  124. When the user exits (with `electric-help-exit', or otherwise) the help
  125. buffer's window disappears (i.e., we use `save-window-excursion')
  126. BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
  127.   (setq buffer (get-buffer-create (or buffer "*Help*")))
  128.   (let ((one (one-window-p t))
  129.     (config (current-window-configuration))
  130.         (bury nil)
  131.         (electric-help-form-to-execute nil))
  132.     (unwind-protect
  133.     (save-excursion
  134.       (if one (goto-char (window-start (selected-window))))
  135.       (let ((pop-up-windows t))
  136.         (pop-to-buffer buffer))
  137.       (save-excursion
  138.         (set-buffer buffer)
  139.         (if (and minheight (< (window-height) minheight))
  140.         (enlarge-window (- minheight (window-height))))
  141.         (electric-help-mode)
  142.         (setq buffer-read-only nil)
  143.         (or noerase
  144.         (erase-buffer)))
  145.       (let ((standard-output buffer))
  146.         (if (not (funcall thunk))
  147.         (progn
  148.           (set-buffer buffer)
  149.           (set-buffer-modified-p nil)
  150.           (goto-char (point-min))
  151.           (if one (shrink-window-if-larger-than-buffer (selected-window))))))
  152.       (set-buffer buffer)
  153.       (run-hooks 'electric-help-mode-hook)
  154.       (setq buffer-read-only t)
  155.       (if (eq (car-safe
  156.            ;; XEmacs: Don't be screwed by minor-modes (view-minor-mode)
  157.            (let ((overriding-local-map electric-help-map))
  158.              (electric-help-command-loop)))
  159.           'retain)
  160.           (setq config (current-window-configuration))
  161.         (setq bury t)))
  162.       (message "")
  163.       (set-buffer buffer)
  164.       (setq buffer-read-only nil)
  165.       (condition-case ()
  166.       (funcall (or default-major-mode 'fundamental-mode))
  167.     (error nil))
  168.       (set-window-configuration config)
  169.       (if bury
  170.           (progn
  171.             ;;>> Perhaps this shouldn't be done.
  172.             ;; so that when we say "Press space to bury" we mean it
  173.             (replace-buffer-in-windows buffer)
  174.             ;; must do this outside of save-window-excursion
  175.             (bury-buffer buffer)))
  176.       (eval electric-help-form-to-execute))))
  177.  
  178. (defun electric-help-command-loop ()
  179.   (catch 'exit
  180.     (if (pos-visible-in-window-p (point-max))
  181.     (progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
  182.            ;; XEmacs change
  183.            (if (equal (setq unread-command-events
  184.                 (list (next-command-event)))
  185.               '(?\ ))
  186.            (progn (setq unread-command-events nil)
  187.               (throw 'exit t)))))
  188.     (let (up down both neither
  189.       (standard (and (eq (key-binding " ")
  190.                  'scroll-up)
  191.              (eq (key-binding "\^?")
  192.                  'scroll-down)
  193.              (eq (key-binding "q")
  194.                  'electric-help-exit)
  195.              (eq (key-binding "r")
  196.                  'electric-help-retain))))
  197.       (Electric-command-loop
  198.         'exit
  199.     (function (lambda ()
  200.       (sit-for 0) ;necessary if last command was end-of-buffer or 
  201.                   ;beginning-of-buffer - otherwise pos-visible-in-window-p 
  202.                   ;will yield a wrong result.
  203.       (let ((min (pos-visible-in-window-p (point-min)))
  204.         (max (pos-visible-in-window-p (point-max))))
  205.         (cond (isearch-mode 'noprompt)
  206.           ((and min max)
  207.            (cond (standard "Press q to exit, r to retain ")
  208.              (neither)
  209.              (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
  210.           (min
  211.            (cond (standard "Press SPC to scroll, q to exit, r to retain ")
  212.              (up)
  213.              (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
  214.           (max
  215.            (cond (standard "Press DEL to scroll back, q to exit, r to retain ")
  216.              (down)
  217.              (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
  218.           (t
  219.            (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
  220.              (both)
  221.              (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))))
  222.             t))))
  223.  
  224.  
  225.  
  226. ;(defun electric-help-scroll-up (arg)
  227. ;  ">>>Doc"
  228. ;  (interactive "P")
  229. ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
  230. ;      (electric-help-exit)
  231. ;    (scroll-up arg)))
  232.  
  233. (defun electric-help-exit ()
  234.   ">>>Doc"
  235.   (interactive)
  236.   (throw 'exit t))
  237.  
  238. (defun electric-help-retain ()
  239.   "Exit `electric-help', retaining the current window/buffer configuration.
  240. \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
  241. will select it.)"
  242.   (interactive)
  243.   ;; Make sure that we don't throw twice, even if two events cause
  244.   ;; calling this function:
  245.   (if (memq 'electric-help-retain mouse-leave-buffer-hook)
  246.       (progn
  247.     (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
  248.     (throw 'exit '(retain)))))
  249.  
  250.  
  251. (defun electric-help-undefined ()
  252.   (interactive)
  253.   (error "%s is undefined -- Press %s to exit"
  254.      (mapconcat 'single-key-description (this-command-keys) " ")
  255.      (if (eq (key-binding "q") 'electric-help-exit)
  256.          "q"
  257.        (substitute-command-keys "\\[electric-help-exit]"))))
  258.  
  259.  
  260. ;>>> this needs to be hairified (recursive help, anybody?)
  261. (defun electric-help-help ()
  262.   (interactive)
  263.   (if (and (eq (key-binding "q") 'electric-help-exit)
  264.        (eq (key-binding " ") 'scroll-up)
  265.        (eq (key-binding "\^?") 'scroll-down)
  266.        (eq (key-binding "r") 'electric-help-retain))
  267.       (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
  268.     (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
  269.   (sit-for 2))
  270.  
  271.  
  272. ;;;###autoload
  273. (defun electric-helpify (fun &optional name)
  274.   (let ((name (or name "*Help*")))
  275.     (if (save-window-excursion
  276.       ;; kludge-o-rama
  277.       (let* ((p (symbol-function 'print-help-return-message))
  278.          (b (get-buffer name))
  279.          (m (buffer-modified-p b)))
  280.         (and b (not (get-buffer-window b))
  281.          (setq b nil))
  282.         (unwind-protect
  283.         (progn
  284.           (message "%s..." (capitalize (symbol-name fun)))
  285.           ;; with-output-to-temp-buffer marks the buffer as unmodified.
  286.           ;; kludging excessively and relying on that as some sort
  287.           ;;  of indication leads to the following abomination...
  288.           ;;>> This would be doable without such icky kludges if either
  289.           ;;>> (a) there were a function to read the interactive
  290.           ;;>>     args for a command and return a list of those args.
  291.           ;;>>     (To which one would then just apply the command)
  292.           ;;>>     (The only problem with this is that interactive-p
  293.           ;;>>      would break, but that is such a misfeature in
  294.           ;;>>      any case that I don't care)
  295.           ;;>>     It is easy to do this for emacs-lisp functions;
  296.           ;;>>     the only problem is getting the interactive spec
  297.           ;;>>     for subrs
  298.           ;;>> (b) there were a function which returned a
  299.           ;;>>     modification-tick for a buffer.  One could tell
  300.           ;;>>     whether a buffer had changed by whether the
  301.           ;;>>     modification-tick were different.
  302.           ;;>>     (Presumably there would have to be a way to either
  303.           ;;>>      restore the tick to some previous value, or to
  304.           ;;>>      suspend updating of the tick in order to allow
  305.           ;;>>      things like momentary-string-display)
  306.           (and b
  307.                (save-excursion
  308.              (set-buffer b)
  309.              (set-buffer-modified-p t)))
  310.           (fset 'print-help-return-message 'ignore)
  311.           (call-interactively fun)
  312.           (and (get-buffer name)
  313.                (get-buffer-window (get-buffer name))
  314.                (or (not b)
  315.                (not (eq b (get-buffer name)))
  316.                (not (buffer-modified-p b)))))
  317.           (fset 'print-help-return-message p)
  318.           (and b (buffer-name b)
  319.            (save-excursion
  320.              (set-buffer b)
  321.              (set-buffer-modified-p m))))))
  322.     (with-electric-help 'ignore name t))))
  323.  
  324.  
  325.  
  326. ;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then 
  327. ;; continues with execute-extended-command.
  328. (defun electric-help-execute-extended (prefixarg)
  329.   (interactive "p")
  330.   (setq electric-help-form-to-execute '(execute-extended-command nil))
  331.   (electric-help-retain))
  332.  
  333. ;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
  334. ;; continues with ctrl-x prefix.
  335. (defun electric-help-ctrl-x-prefix (prefixarg)
  336.   (interactive "p")
  337.   (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
  338.   (electric-help-retain))
  339.  
  340.  
  341. (defun electric-describe-key ()
  342.   (interactive)
  343.   (electric-helpify 'describe-key))
  344.  
  345. (defun electric-describe-mode ()
  346.   (interactive)
  347.   (electric-helpify 'describe-mode))
  348.  
  349. (defun electric-view-lossage ()
  350.   (interactive)
  351.   (electric-helpify 'view-lossage))
  352.  
  353. ;(defun electric-help-for-help ()
  354. ;  "See help-for-help"
  355. ;  (interactive)
  356. ;  )
  357.  
  358. (defun electric-describe-function ()
  359.   (interactive)
  360.   (electric-helpify 'describe-function))
  361.  
  362. (defun electric-describe-variable ()
  363.   (interactive)
  364.   (electric-helpify 'describe-variable))
  365.  
  366. (defun electric-describe-bindings ()
  367.   (interactive)
  368.   (electric-helpify 'describe-bindings))
  369.  
  370. (defun electric-describe-syntax ()
  371.   (interactive)
  372.   (electric-helpify 'describe-syntax))
  373.  
  374. (defun electric-command-apropos ()
  375.   (interactive)
  376.   (electric-helpify 'command-apropos "*Apropos*"))
  377.  
  378. ;(define-key help-map "a" 'electric-command-apropos)
  379.  
  380. (defun electric-apropos ()
  381.   (interactive)
  382.   (electric-helpify 'apropos))
  383.  
  384.  
  385. ;;;; ehelp-map
  386.  
  387. (defvar ehelp-map ())
  388. (if ehelp-map
  389.     nil
  390.   ;; #### WTF?  Why don't we just use substitute-key-definition
  391.   ;; like FSF does?
  392.   (let ((shadow '((apropos . electric-apropos)
  393.           (command-apropos . electric-command-apropos)
  394.           (describe-key . electric-describe-key) 
  395.                   (describe-mode . electric-describe-mode)
  396.                   (view-lossage . electric-view-lossage) 
  397.                   (describe-function . electric-describe-function)
  398.                   (describe-variable . electric-describe-variable)
  399.                   (describe-bindings . electric-describe-bindings)
  400.                   (describe-syntax . electric-describe-syntax)))
  401.         (map (make-sparse-keymap)))
  402.     (set-keymap-name map 'ehelp-map)
  403.     (set-keymap-parents map (list help-map))
  404.     ;; Shadow bindings which would be inherited from help-map
  405.     ;;#### This doesn't descend into sub-keymaps
  406.     (map-keymap (function (lambda (key binding)
  407.                               (let ((tem (assq binding shadow)))
  408.                                 (if tem
  409.                                     (define-key map key (cdr tem))))))
  410.                 help-map)
  411.     (setq ehelp-map map)
  412.     (fset 'ehelp-command map)))
  413.  
  414. ;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
  415.  
  416. (provide 'ehelp) 
  417.  
  418. ;;; ehelp.el ends here
  419.